Shareware Grab Bag/Shareware Grab Bag.iso/050/madtrb36.arc/LOAN1.INC

Text File | 1986-02-08 | 35.3 KB | 887 lines

const  ZERO        =  0;    { Used to clarify code.                     }
       FILL_CHAR   = '_';   { Defines char. used to mark input fields.  }
       SPACE       = ' ';   { Represents the ASCII space character, #32 }
       NULL        = '';    { Represents a null string.                 }

{ Output Control Characters }

       NUL         = #0;    { Null character.                }
       BELL        = #7;    { Causes a beep when output to a }
                            { terminal that has sound.       }
       BS          = #8;    { Backspace.                     }
       TAB         = #9;    { Tab character.                 }
       LF          = #10;   { Line Feed.                     }
       CR          = #13;   { Carriage Return.               }
       FF          = #12;   { Form Feed.                     }
       ESC         = #27;   { Escape character.              }
       DEL         = #127;  { Del or Rubout character.       }

{ Video Limits & Locations }

       MAX_ROW     = 24;      { Maximum number of rows for video.    }
       MAX_COL     = 80;      { Maximum number of columns for video. }
       MSG_LINE    = 22;      { Line to be used for user messages.   }
       PROMPT_LINE = 23;      { Used for prompts, extended messages  }
                              { and commands.                        }
       CMD_LINE    = 24;      { Primary command input line.          }

{ Input Control Keys:  Keyboard character code and video representation
                       of keys used in Loan_Amortization application.
                       Add others for general purpose use. The definitions
                       shown will work on any Turbo supported system. The
                       alternate definitions, which are commented out, will
                       allow the IBM-PC and compatibles to use function and
                       cursor control keys as indicated. }


       BACKSP      = BS;           { Backspace or left arrow key.         }
{      BS_KEY      = #32#17#196#196#32;    IBM-PC backspace key symbol.   }
       BS_KEY      = ' <BkSpc> ';  { Use text appropriate for keyboard.   }
       ENTER       = CR;           { Return or Enter key.                 }
{      ENTER_KEY   = #32#17#196#217#32;    IBM-PC enter key symbol.       }
       ENTER_KEY   = ' <Enter> ';  { Use text appropriate for keyboard.   }
       CLEAR       = TAB;          { Forward tab key or ^I.               }
{      CLEAR_KEY   = #32#196#196#16#221#32;   IBM-PC tab key symbol.      }
       CLEAR_KEY   = ' <Tab> ';    { Use text appropriate for keyboard.   }
       QUIT        = ESC;          { Escape key.                          }
       QUIT_KEY    = ' <Esc> ';    { Use text appropriate for keyboard.   }
{      PREV        = #72;            IBM up arrow key scan code.          }
{      PREV_KEY    = #32#24#32;      IBM-PC up arrow symbol.              }
       PREV        = ^E;           { Use code appropriate for key used.   }
       PREV_KEY    = ' ^E ';       { Use text appropriate for keyboard.   }
{      HELP        = #59;            IBM-PC F1 key scan code.             }
{      HELP_KEY    = ' F1 ';         IBM-PC                               }
       HELP        = ^A;           { Use code appropriate for key used.   }
       HELP_KEY    = ' ^A ';       { Use text appropriate for keyboard.   }
       LEAD_IN     = ESC;          { Lead in char. for IBM function keys. }
                                   { Change as needed for other systems.  }

{ String types:  General purpose string types. }

type   Str_5       = string[5];
       Str_10      = string[10];
       Str_15      = string[15];
       Str_20      = string[20];
       Str_30      = string[30];
       Str_40      = string[40];
       Str_60      = string[60];
       Str_80      = string[80];
       Str_255     = string[255];
       File_ID     = string[64];
       Drive_ID    = string[2];

{ Set types: }

       Any_Char       = set of Char;       { Defined set of all characters.  }
       Printable_Char = set of ' '..'~';   { Set of printable characters.    }
       Special_Char   = set of #128..#255; { Set of Non-standard characters. }
       Control_Char   = set of #0..#127;   { Set of Control characters. This }
                                           { includes DEL and the IBM-PC     }
                                           { function key scan codes.        }

var  default,                     { General purpose string buffer.         }
     inp_str       : Str_255;     { Keyboard input string buffer.          }
     i, j, k,                     { Misc. loop counter variables.          }
     io_status     : Integer;     { Global status variable.                }
     inctl,                       { Global control character.              }
     inchr         : Char;        { Global input character.                }
     output_id     : File_ID;     { Store ID of current output file/device.}
     esc_flag,                    { Global logic control flags.            }
     err_flag,
     help_flag,
     quit_flag,
     end_session   : Boolean;


{ Additional global constants types and variables required for data
  input and display routines. }

const  MAX_FLD     = 32;  { Set maximum number of input fields permitted. }

{ Field input type codes. }

       TEXT_FLD    = 'T'; { Text field. Used for screen doc. only. }
       UC_TEXT     = 'U'; { Upper Case text field.                 }
       NUMERIC     = 'N'; { Numeric field.                         }

{ Field exit type codes. }

       REQUIRED    = 'R'; { Identifies field that requires an entry.       }
       PROTECTED   = 'P'; { Identifies a field to be skipped during input. }
       MANUAL      = 'M'; { Manual exit field. User must press <CR>.       }
       AUTOMATIC   = 'A'; { Automatic exit after last char. is entered.    }

       INCR        = 1;     { INCR & DECR are used to set the }
       DECR        = -1;    { direction indicator variable.   }

{ Define data structure to hold input field parameters. }

type   Fld_Parms   = record
                       xloc        : Integer;  { Video column.              }
                       yloc        : Integer;  { Video row.                 }
                       fld_len     : Integer;  { Maximum field length.      }
                       fld_type    : Char;     { See input constants above. }
                       exit_type   : Char;     { See exit constants above.  }
                       fld_msg     : Str_60;   { User prompt message.       }
                     end;

{ Define data structure to hold text for video screens. }

       Scrn        = array[1..MAX_ROW] of Str_80;

{ Define an array of field parameter records. }

       Inp_Parms   = array[1..MAX_FLD] of Fld_Parms; { Input field parameters. }

{ Define pointer and record for help screen text. }

       Help_Pointer = ^Help_Text;

       Help_Text    = record
                        help_txt   : Str_80;
                        next_line  : Help_Pointer;
                      end;

{ Global variables used by standard input and display routines. }

var  fld_cnt,                  { Holds number of fields on current screen. }
     direction     : Integer;  { Increment/Decrement indicator.            }
     top_of_heap   : ^Integer; { Dummy pointer for use by Mark & Release.  }
     first_help    : Help_Pointer; { Pointer to first line of help text.   }


{ Forward declaration of error handling routines which use some of the
  routines in the STD-UTIL.INC file and are also used by some of these
  routines. }

    procedure Disp_IO_Error(device_name: File_ID); forward;

    procedure Disp_Error_Msg(err_msg: Str_80); forward;

    procedure Beep;
      begin
        Write(BELL);  { Use this statement for non-IBM-PC systems.         }
(*      begin         { This routine may be substituted on IBM-PC systems. }
          Sound(440); Delay(250); NoSound;
        end;                                                              *)
      end; { Beep }

    procedure Repeat_Char(character : Char;     { Character to be output.    }
                          count     : Integer); { Number of times to output. }
      var i     : Integer;

      begin
        i := ZERO;
        while (i < count) do
          begin
            Write(character);
            i := Succ(i);
          end;
      end; { Repeat_Char }

    procedure Strip_Trailing_Char(var inp_str : Str_255; { String to strip.}
                                      len     : Byte;    { Maximum length. }
                                      strip   : Char);   { Char. to strip. }

  { Scan inp_str from len downto 0 until a character <> strip is found.
    Set the length of inp_str equal to the position of the character
    found if any. Note that inp_str is set to null if it contains only
    strip characters. }

      begin
        inp_str[0] := Chr(0);       { Set inp_str length byte to ZERO. }
        while (inp_str[len] = strip) and (len > ZERO) do
          len := Pred(len);
        inp_str[0] := Chr(len);     { Set inp_str length to len. }
      end; { Strip_Trailing_Char }

    procedure Strip_Leading_Char(var inp_str : Str_255; { String to strip. }
                                     len     : Byte;    { Maximum length.  }
                                     strip   : Char);   { Char. to strip.  }

      var  i         : Byte;

  { Find the first occurrence, if any, of a character not equal to strip.
    Copy the remainder of inp_str into the new inp_str. Note inp_str is set
    to null if it is null initially or it contains only strip characters. }

      begin
        i := 1;
        While (inp_str[i] = strip) and (i <= len) do
          i := Succ(i);
        inp_str := Copy(inp_str,i,len);
      end; { Strip_Leading_Char }


    function Stripped(inp_str : Str_255;        { String to strip. }
                      len     : Byte;           { Maximum length.  }
                      strip   : Char): Str_255; { Char. to strip.  }

{ Uses procedures defined above to strip leading and trailing
  occurances of the character strip from inp_str. }

      begin
        Strip_Trailing_Char(inp_str,len,strip);
        Strip_Leading_Char(inp_str,len,strip);
        Stripped := inp_str;
      end; { Stripped }

  function Exist(file_name: File_ID): Boolean;
    var chk_file  : File;

    begin
      Assign(chk_file,file_name);
{$I-} Reset(chk_file); {$I+}
      Exist := (IOresult = ZERO);
{$I-} Close(chk_file); io_status := IOresult; {$I+}
    end; { Exist }

    procedure Read_Kbd(var inchr,inctl: Char);

{    Keyboard input routine that will allow users of systems with
     `IBM-PC type' function keys to use those keys as control keys.
     It will also work on systems using standard control keys producing
     ASCII characters #1..#31 & #127. The variable parameters will
     be set as follows depending on the key that is pressed.

     inchr  will contain the character value of the key pressed.
            If a control/function key is pressed this will be the
            `lead in' value for the key, if any.  For example the
            lead in character for function keys on many systems is the
            escape character, ASCII #27.
     inctl  will contain NUL or a control/function key value which may be
            used to determine whether a control/function key was pressed
            and if so which key it was. }

      begin
        inctl := NUL;                    { Initialize to inctl to NUL.    }
        Read(Kbd,inchr);                 { Wait for a key to be pressed.  }
        if (KeyPressed and (inchr = LEAD_IN)) then
          begin                          { Get function key scan code.    }
            Delay(0);                    { Increase Delay if needed.      }
            Read(Kbd,inctl);             { Scan code goes in inctl.       }
          end
        else
          if (inchr in [#1..#31,DEL]) then
            inctl := inchr;              { Trap conventional control chrs.}
      end; { Read_Kbd }

  function Valid_Key(valid_keys: Any_Char): Char;
    var inchr, inctl : Char;

{ Waits for a key to be pressed that is a member of the set valid_keys.
  The ASCII value of the key is returned. Non-control keys are
  displayed. A beep is sounded for invalid keys.

  Note that alpha characters are forced to upper case. }

     begin
       repeat
         Read_Kbd(inchr,inctl);        { Wait for a key to be pressed. }
         if (inctl = NUL) then
           begin                       { If it is not a control key    }
             inchr := UpCase(inchr);   { force it to upper case and    }
             Write(inchr,BS);          { display it, restoring cursor. }
           end
         else                          { If it is a control key then   }
           inchr := inctl;             { pass it through for testing.  }
         if (not (inchr in valid_keys)) then
           Beep;                       { Beep if it's not valid.       }
       until (inchr in valid_keys);
       Valid_Key := inchr;             { Return the valid character.   }
     end; { Valid_Key }

  procedure Init_Field (init_char : Char;
                        var parms : Fld_Parms);
    var  i   : Byte;

{ Initialize field with init_char based on parms.
  Parameters are:

  init_char  Fill character to be used for field initialization.
  parms      Input field parameters for the field to be initialized. }

    begin
      with parms do
      begin
        GoToXY(xloc,yloc);                { Position cursor. }
        Repeat_Char(init_char,fld_len);   { Init field with init_char. }
        GoToXY(xloc,yloc);                { Restore cursor position. }
      end;
    end; { Init_Field }

  procedure Get_Field_Input(var parms    : Fld_Parms;
                            var chr_set  : Printable_Char;
                            var ctrl_set : Control_Char);

    var   count  : Integer; { Number of characters entered. }
          exit   : Boolean; { Local exit flag.              }

{ General purpose keyboard input routine.
  Parameters are:
  parms      Input field parameters for the field to be processed.
  chr_set    Set of characters acceptable for input. Beep for others.
  ctrl_set   Set of control/fuction characters acceptable for input. }

{ Global variables used:
         esc_flag    Boolean   Global exit flag.
         inp_str     Str_255   Input buffer string. Note that
                               Length(inp_str) is set to count on exit.
         direction   Integer   Increment/Decrement indicator. Switched to
                               DECR if valid control character is PREV.
         inchr       Char      Used to store input character.
         inctl       Char      Used to store input control/function code. }

    procedure Process_Control_Character;
      var i  : Byte;

  { Select action based on control key pressed by user. }

  { Global variables used:
           esc_flag  : Boolean;  Used to indicate that QUIT key pressed.
           help_flag : Boolean;  Used to indicate that HELP key pressed.
           direction : Integer;  Increment/Decrement indicator. }

      procedure Backspace(fill: Char);

    { Perform destructive backspace on video and remove last character
      from inp_str. The parameter is:

      fill   Character to be output in place of character deleted. }

        begin
          if (count > ZERO) then
            begin
              Write(BS,fill,BS);     { Destructive backspace to video.     }
              count := Pred(count);  { Decrement characters entered count. }
            end
          else
            Beep;                    { Beep if count = ZERO initially.     }
        end; { Backspace }

      procedure Clear_Field;
        var i : Byte;

    { Initialize video field and clear input string. }

        begin
          Init_Field(FILL_CHAR,parms);           { Clear video field. }
          with parms do
            FillChar(inp_str,fld_len + 1,ZERO);  { Clear inp_str. }
          count := ZERO;                         { Reset count to ZERO. }
        end; { Clear_Field }

      begin { Process_Control_Character }
        case inctl of
            BACKSP  : Backspace(FILL_CHAR);
            ENTER   : exit := TRUE;
            QUIT    : begin
                        esc_flag := TRUE;
                        exit := TRUE;
                      end;
            PREV    : begin
                        Clear_Field;
                        direction := DECR;
                        exit := TRUE;
                      end;
            CLEAR   : begin
                        Clear_Field;
                        exit := TRUE;
                      end;
            HELP    : begin
                        help_flag := TRUE;
                        exit := TRUE;
                      end;
            else      Beep;
        end; {case}
      end; { Process_Control_Character }

    procedure Accept_Valid_Character;

  { If inchr is a member of chr_set and that the field length has
    not been exceeded, display inchr, increment count
    and store the character in inp_str; otherwise Beep.
    If the end of an AUTOMATIC exit field is reached set the exit
    flag and indicate that a CR has been received by setting inctl to CR. }

      begin
        with parms do
        begin
          if (fld_type = UC_TEXT) then
            inchr := UpCase(inchr);
          if (inchr in chr_set) and (count < fld_len) then
            begin
              Write(inchr);
              count := Succ(count);
              inp_str[count] := inchr;
              if (exit_type = AUTOMATIC) and (count = fld_len) then
                begin
                  exit := TRUE; inctl := CR;
                end;
            end
          else
            Beep;
        end;
      end; { Accept_Valid_Character }

    begin { Get_Field_Input }
      count := ZERO;
      esc_flag := FALSE; exit := FALSE;
      direction := INCR;
      repeat
        Read_Kbd(inchr,inctl);
        if (inctl in ctrl_set) then
          Process_Control_Character
        else
          Accept_Valid_Character;
      until exit;
      inp_str[0] := Chr(count);             { Set length of input string.  }
      Repeat_Char(SPACE,(parms.fld_len - count)); { Clear to end of field. }
    end; { Get_Field_Input }

  function Valid_Str(var parms: Fld_Parms): Str_80;

    const chr_set     : Printable_Char = [SPACE..'~'];
          ctrl_set    : Control_Char   = [CR,BS,CLEAR,PREV,QUIT];

{ Accepts field input based on parms. If the user presses <CR> without
  entering anything, the value of the global default string is returned.
  Otherwise the characters entered, up to the maximum indicated by
  parms.fld_len, are returned as a string. }

    begin
      Valid_Str := default;    { Returns default if no value is entered. }
      Get_Field_Input(parms,chr_set,ctrl_set);
      if ((inctl = CR) and (Length(inp_str) > ZERO)) or
         (inctl = CLEAR) then
        Valid_Str := inp_str;
    end; { Valid_Str }

  function Valid_Real(var parms   : Fld_Parms;
                          point   : Byte;
                          min,max : Real): Real;

    const chr_set     : Printable_Char = ['0'..'9','-','.'];
          ctrl_set    : Control_Char   = [CR,BS,CLEAR,PREV,QUIT];

    var   real_val    : Real;
          min_str,
          max_str     : Str_20;
          err_msg     : Str_80;

{ Accepts field input based on parms. If the user presses <CR> without
  entering anything, the Real value of the global default string is returned.
  Otherwise the string entered is converted to a Real value. If the value
  is not in the range indicated by min and max or a there is an error in
  the conversion, an error message is displayed. }

    begin { Valid_Real }
      Val(Stripped(default,Length(default),SPACE),real_val,io_status);
      if io_status <> ZERO then  { If default is a bad numeric value      }
        real_val := 0.0;         { then return 0.0.                       }
      Valid_Real := real_val;    { Return default if no value is entered. }
      Get_Field_Input(parms,chr_set,ctrl_set);
      if ((inctl = CR) and (Length(inp_str) > ZERO)) or
         (inctl = CLEAR) then
        begin
          if (inctl = CLEAR) then
            inp_str := '0.00';
          Val(inp_str,real_val,io_status);
          if (io_status = ZERO) and
             ((real_val >= min) and (real_val <= max)) then
            Valid_Real := real_val
          else
            begin
              Str(min:parms.fld_len:point,min_str); { The point parameter    }
              Str(max:parms.fld_len:point,max_str); { indicates the position }
              err_msg := 'Value must be from '      { of the decimal point.  }
                          + min_str + ' through ' + max_str;
              Disp_Error_Msg(err_msg);
              direction := ZERO;            { Force re-entry of field. }
            end;
        end;
    end; { Valid_Real}

  function Valid_Int(var parms   : Fld_Parms;
                         min,max : Integer): Integer;

    const chr_set     : Printable_Char = ['0'..'9','-'];
          ctrl_set    : Control_Char   = [CR,BS,CLEAR,PREV,QUIT];

    var   int_val     : Integer;
          min_str,
          max_str     : Str_20;
          err_msg     : Str_80;

{ Accepts field input based on parms. If the user presses <CR> without
  entering anything, the Integer value of the global default string is returned.
  Otherwise the string entered is converted to an Integer value. If the value
  is not in the range indicated by min and max or a there is an error in
  the conversion, an error message is displayed. }

    begin { Valid_Int }
      Val(Stripped(default,Length(default),SPACE),int_val,io_status);
      if io_status <> ZERO then { If default is a bad numeric value      }
        int_val := ZERO;        { then return ZERO.                      }
      Valid_Int := int_val;     { Return default if no value is entered. }
      Get_Field_Input(parms,chr_set,ctrl_set);
      if ((inctl = CR) and (Length(inp_str) > ZERO)) or
         (inctl = CLEAR) then
        begin
          if (inctl = CLEAR) then
            inp_str := '0';
          Val(inp_str,int_val,io_status);
          if (io_status = ZERO) and
             ((int_val >= min) and (int_val <= max)) then
            Valid_Int := int_val
          else
            begin
              Str(min:parms.fld_len,min_str);
              Str(max:parms.fld_len,max_str);
              err_msg := 'Value must be from ' + min_str +
                         ' through ' + max_str;
              Disp_Error_Msg(err_msg);
              direction := ZERO;             { Forces re-entry of field. }
            end;
        end;
    end; { Valid_Int }

  function Valid_Chr(var parms     : Fld_Parms;
                         valid_set : Printable_Char): Char;

    const ctrl_set : Control_Char  = [CR,BS,CLEAR,PREV,QUIT];

{ Accepts field input based on parms. If the user presses <CR> without
  entering anything, the first character of the global default string is
  returned. Otherwise the user must enter a character that is a member of
  the valid_set parameter. }

    begin  { Valid_Chr }
      Valid_Chr := default[1]; { Returns default if no value is entered. }
      Get_Field_Input(parms,valid_set,ctrl_set);
      if ((inctl = CR) and (Length(inp_str) > ZERO)) or
         (inctl = CLEAR) then
        Valid_Chr := inp_str[1]
    end; { Valid_Chr }

   procedure Clr_Eol(line: Byte);
     var blank_line : Str_80;

{ Alternate clear to end of line routine for systems that scroll the
  video screen when a Turbo ClrEol is executed on the 24th line.
}
     begin
       FillChar(blank_line,81,SPACE); blank_line[0] := Chr(79);
       GoToXY(1,line); Write(blank_line);
       GoToXY(1,line);
     end; { Clr_Eol }

   procedure Clear_Prompts;

 { Clears the prompt area as defined by the global constants used. }

     begin
       GoToXY(1,MSG_LINE); ClrEol;
       GoToXY(1,PROMPT_LINE); ClrEol;
       GoToXY(1,CMD_LINE); Clr_Eol(CMD_LINE); { Systems with 25 video lines }
     end; { Clear_Prompts }                   { can use ClrEol.             }

   procedure Display_Prompt(line    : Byte;
                            prompt  : Str_10;
                            msg_str : Str_80);

{  Displays prompt & highlighted msg_str at line.
   Parameters are:
   line     The video line on which the prompt and msg_str are displayed.
   prompt   A string that identifies the nature of the message.
   msg_str  The message to be displayed.

   Note: The calling routine must preserve and restore the cursor position
         and video intensity as needed.
         Combined length of prompt & msg_str should be less than 76.
}
    begin { Display_Prompt }
      GoToXY(1,line); Clr_Eol(line);  { Systems with 25 video lines }
      LowVideo;                       { can use ClrEol. }
      Write(Prompt,': '); NormVideo;
      Write(msg_str);
    end; { Display_Prompt }

  procedure Disp_Error_Msg; { (err_msg: Str_80); }
    var  inchr : Char;      { forward defined in STD-UTIL.PAS }

{ Displays err_msg at MSG_LINE and a `continue prompt' at PROMPT_LINE.
  Clears both lines when user presses any key.

  Note: The calling routine must preserve and restore cursor position and
        video intensity as well as the contents of the MSG_LINE & PROMPT_LINE. }

    begin
      Display_Prompt(MSG_LINE,'ERR',err_msg); GoToXY(1,PROMPT_LINE);
      Display_Prompt(PROMPT_LINE,
                       'MSG','Press ANY KEY to try again. ==> ');
      Beep;
      Read(Kbd,inchr);                  { Pause until key is pressed }
      GoToXY(1,MSG_LINE); ClrEol; GoToXY(1,PROMPT_LINE); ClrEol;
    end; { Disp_Error_Msg }

  procedure Disp_IO_Error;   { (device_name: File_ID); }
                             { forward defined in STD-UTIL.PAS }
    var IO_Msg     : Str_80;
        err_str    : string[3];
        valid_keys : Printable_Char;

 { Converts global io_status to a text error message combined with its
   device_name parameter. Displays error message and sets global error_flag. }

    begin
      case io_status of
        $01  :  IO_Msg := 'not found';
        $02  :  IO_Msg := 'not open for input';
        $03  :  IO_Msg := 'not open for output';
        $04  :  IO_Msg := 'not open';
        $05  :  IO_Msg := 'not readable';
        $06  :  IO_Msg := 'not Assigned. Unable to Write';
        $10  :  IO_Msg := 'recieved bad numeric data';
        $20  :  IO_Msg := 'not able to perform operation requested';
        $21  :  IO_Msg := 'not available in Memory mode';
        $22  :  IO_Msg := 'not available for Assign statement';
        $90  :  IO_Msg := 'does not contain matching record type';
        $91  :  IO_Msg := 'does not contain record requested';
        $99  :  IO_Msg := 'end encountered unexpectedly';
        $F0  :  IO_Msg := 'cannot be written to';
        $F1  :  IO_Msg := 'cannot be written due to full Directory';
        $F2  :  IO_Msg := 'has exceeded the maximum file size';
        $FF  :  IO_Msg := 'is no longer on the current disk';
      else      begin
                  Str(io_status:3,err_str);
                  IO_Msg := 'has experienced I/O error:' + err_str;
                end;
      end; {case}
      Clear_Prompts;
      IO_Msg := 'Device/File ' + device_name + ' ' + IO_Msg;
      Display_Prompt(PROMPT_LINE,'MSG',IO_Msg);
      Display_Prompt(CMD_LINE,'CMD','Ignore |  Abort');
      Display_Prompt(MSG_LINE,'INP',
                      'Press CMD: key to enter selection. (I/A) ==> ');
      if (Valid_Key(['A','I']) = 'A') then
        err_flag := TRUE
      else
        io_status := ZERO;
    end; { Disp_IO_Error }

  procedure Load_SCR_File(file_name     : File_ID;
                          var text_buf  : Scrn;
                          var text_file : Text);
    var line_cnt : Byte;

{ Loads up to MAX_ROW lines of text from text_file into text_buf.
  if text file contains more than MAX_ROW lines of text, io_status
  is set to MAX_ROW + 1. Any other value of io_status greater than 0
  should be treated as an I/O error. It is left to the calling routine
  to handle such errors.
  Text_file is left open so that the calling routine may Read additional
  text if necessary. The caller is responsible for closing text_file. }

    begin
      Assign(text_file,file_name);
{$I-}
      Reset(text_file); io_status := IOresult;
      line_cnt := 1;
      While (io_status = ZERO) and (not Eof(text_file)) do
        if line_cnt > MAX_ROW then
          io_status := line_cnt
        else
          begin
            ReadLn(text_file,text_buf[line_cnt]);
            io_status := IOresult;
            if (io_status = ZERO) then
              line_cnt := Succ(line_cnt)
            else
              Disp_IO_Error(file_name);
          end;
{$I+}
    end; { Load_SCR_File }

  procedure Load_Input_Scrn(scrn_id       : File_ID;
                            var scrn_text : Scrn;
                            var fld_dat   : Inp_Parms);

    type Txt_Num             = string[2];

    var  scrn_file           : Text;
         txt_x, txt_y,
         txt_cnt, txt_len    : Txt_Num;
         i                   : Byte;
         dummy               : Char;

{ Loads the screen text from file identified by scrn_id into the
  screen buffer pointed to by scrn_text. The input field parameters
  are then loaded into the fld_dat array. }

    procedure Read_Field_Parameters;
      var status : array[1..10] of Integer;  { Used for error trapping. }

{   Reads parameters for fld_cnt fields into fld_dat parameter array.
    The format of the parameter in scrn_file must be a follows:

    n1,n2,n3,X,Y,Msg

    n1  = 2 digit video screen row of input field.
    n2  = 2 digit video screen col of input field.
    n3  = 2 digit length in characters of input field.
    X   = 1 character field type as defined in global constants.
    Y   = 1 character field exit type as defined in global constants.
    Msg = Up to 60 characters, followed by End Of Line. }

      procedure Check_Status;
        begin
          i := 1;                         { Set up loop to check status }
          while (i < 11) do
            if (status[i] <> ZERO) then
              begin                      { If error encountered, display }
                io_status := status[i];  { error message and exit loop. }
                Disp_IO_Error(scrn_id);
                i := 11;
              end
            else
              i := Succ(i);
        end; { Check_Status }

      begin  { Read_Field_Parameters }
        for i := 1 to fld_cnt do
          With fld_dat[i] do
          begin
{$I-}
            Read(scrn_file,txt_y,dummy); status[1] := IOresult;
            Read(scrn_file,txt_x,dummy); status[2] := IOresult;
            Read(scrn_file,txt_len,dummy); status[3] := IOresult;
            Read(scrn_file,fld_type,dummy); status[4] := IOresult;
            Read(scrn_file,exit_type,dummy); status[5] := IOresult;
            ReadLn(scrn_file,fld_msg); status[6] := IOresult;
            Val(txt_x,xloc,io_status); status[7] := io_status;
            Val(txt_y,yloc,io_status); status[8] := io_status;
            Val(txt_len,fld_len,io_status); status[9] := io_status;
          end;
          Close(scrn_file); status[10] := IOresult;
{$I+}
          Check_Status; { Display first error encountered & set error_flag. }
      end; { Read_Field_Parameters }

    begin { Load_Input_Scrn }
      Load_SCR_File(scrn_id,scrn_text,scrn_file); { Load screen text.      }
      if (io_status = (MAX_ROW + 1)) then
        begin
{$I+}
          ReadLn(scrn_file,txt_cnt);              { Read number of fields. }
          io_status := IOresult;
{$I-}
          if (io_status = ZERO) then
            Val(txt_cnt,fld_cnt,io_status);    { Convert fld_cnt to number.}
          if (io_status = ZERO) then
            Read_Field_Parameters
          else
            begin
              Disp_Error_Msg('Conversion error in screen file.');
              err_flag := TRUE;
            end;
        end
          else
            begin
              Disp_Error_Msg('Invalid input screen file.');
              err_flag := TRUE;
            end;
    end { Load_Input_Scrn };

  procedure Disp_Input_Scrn(inp_scrn: Scrn);
    var  i   : Byte;

{ Writes text from inp_scrn screen text buffer to video. }

    begin
      NormVideo;
      for i := 1 to 4 do WriteLn(inp_scrn[i]);
      LowVideo;
      for i := 5 to (MAX_ROW -1) do
         WriteLn(inp_scrn[i]);
      Write(inp_scrn[MAX_ROW]); { Required to prevent scrolling on systems }
      NormVideo;                { with MAX_ROW video lines. }
    end { Disp_Input_Scrn };

    procedure Load_Help_Text(file_name: File_ID);
      const MIN_HEAP = $800;  { Leave at least 2K free on the heap. }

      var help_file : Text;
          new_line,
          last_line : Help_Pointer;

      begin
        Mark(top_of_heap);
        first_help := nil;
        Assign(help_file,file_name);
{$I-}
        Reset(help_file); io_status := IOresult;
          while ((not Eof(help_file)) and (MemAvail > MIN_HEAP)) and
                (io_status = ZERO) do
            begin
              New(new_line);
              ReadLn(help_file,new_line^.help_txt);
              io_status := IOresult;
              if (first_help = nil) then
                first_help := new_line
              else
                last_line^.next_line := new_line;
              last_line := new_line;
              last_line^.next_line := nil;
            end;
{$I+}
          if (io_status <> ZERO) then
            Disp_IO_Error(file_name);
          if (MemAvail <= MIN_HEAP) then
            Disp_Error_Msg('Insufficient memory for complete help file');
      end; { Load_Help_Text }

  procedure Disp_Help(first, last: Integer);
     var line_ptr  : Help_Pointer;
         line_cnt  : Integer;

{ Displays `help screen' information from dynamic memory. The information
  displayed is determined by first and last, which refer to line numbers
  in help_file. Information is displayed starting at row 1 with a dashed
  line followed by (last - first + 1) lines of help text and ends on row
  (last - first + 3) which is another dashed line.

  Note: The calling routine must preserve and restore screen contents.
        Last - first should be less than 20. }

    begin
      GoToXY(1,1); Repeat_Char('-',(MAX_COL - 1)); WriteLn;
      line_ptr := first_help;
      line_cnt := 1;
      while (line_cnt < first) and (line_ptr <> nil) do
        begin
          line_ptr := line_ptr^.next_line;
          line_cnt := Succ(line_cnt);
        end;
      while (line_cnt <= last) and (line_ptr <> nil) do
        begin
          ClrEol;
          WriteLn(line_ptr^.help_txt);
          line_ptr := line_ptr^.next_line;
          line_cnt := Succ(line_cnt);
        end;
      Repeat_Char('-',(MAX_COL - 1));
      Clear_Prompts;
      Display_Prompt(MSG_LINE,'MSG','Press ANY KEY to continue... ');
      Read(Kbd,inchr);
    end; { Disp_Help }

    procedure Verify_Exit;
      begin
        Display_Prompt(MSG_LINE,'INP','Do you want to END this session? (Y/N) ==> ');
        if (Valid_Key(['Y','N']) = 'Y') then
          end_session := TRUE;
      end; { Verify_Exit }